home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 20 / 5 / DISK2058.ZIP / UNFAST.EXE / MUSIC.F < prev    next >
Text File  |  1980-01-01  |  8KB  |  455 lines
  1.  
  2. ;== MUSIC ==================================================================
  3.  
  4. #short
  5. const blen=40*16
  6. bars ? blen+16
  7. bend=bars+blen
  8.  
  9. sharps ? 24
  10.  
  11. tabl   ? 80*7
  12.  
  13. tempo=2000
  14.  
  15. on error
  16.     {
  17.     print bios:error msg "\dos.err":print bios "!"
  18.     stop
  19.     }
  20.  
  21. proc print_bars(bar)
  22.     {
  23.     colour 120
  24.     locate 2,11:print bar+1;"  ";
  25.     locate 2,30:print bar+2;"  ";
  26.     locate 2,49:print bar+3;"  ";
  27.     locate 2,68:print bar+4;"  ";
  28.     colour 7
  29.     fill 1760 from video|480 with 0720h     ;clear bottom of screen
  30.     l=10*160
  31.     repeat 5
  32.     {
  33.     fill 80 from video|l with 07c4h     ;white ─'s
  34.     l2=l
  35.     repeat 3
  36.         {
  37.         video[l2+42]b=197
  38.         video[l2-118]b=179
  39.         l2+=38
  40.         }
  41.     l+=320
  42.     }
  43.     l2=l-118
  44.     repeat 3 video[l2]b=179:l2+=38
  45.  
  46.     m=bars+bar*16
  47.     x=4
  48.     repeat 4
  49.     {
  50.     x2=x+16
  51.     repeat 16
  52.         {
  53.         by=peekb m:m++
  54.         r=by and 31
  55.         if r then
  56.         {
  57.         colour 7
  58.         bn=peekb (note+r)
  59.         if by and 128 then n+=32    ;lowercase = flat
  60.         if by and 64 then colour 15 ;bright    = sharp
  61.         locate 2+r,x:print chr bn;
  62.         colour 7
  63.         }
  64.         if by and 32 then    ;repeat.
  65.         {
  66.         locate 13,x2:print "·";
  67.         locate 15,x2:print "·";
  68.         }
  69.         else if (by and 192)=192 then   ;intro.
  70.         {
  71.         locate 13,x-1:print "i";
  72.         }
  73.         x++
  74.         }
  75.     x+=3
  76.     }
  77.     }
  78.  
  79. proc put_note(py,px)
  80.     {
  81.     r=py and 31
  82.     px=(px/16)*19+4+(px and 15)
  83.     if r then
  84.     {
  85.     colour 7
  86.     n=peekb (note+r)
  87.     if py and 128 then n+=32    ;lowercase = flat
  88.     if py and 64 then colour 15 ;bright    = sharp
  89.     locate 2+r,px:print chr n;
  90.     colour 7
  91.     }
  92.     cursor 2+r,px
  93.     }
  94.  
  95. function music_end
  96.     {
  97.     me=0
  98.     n=0
  99.     while n<blen
  100.     {
  101.     if peekb (bars+n) then me=n or 15   ;to end of bar.
  102.     n++
  103.     }
  104.     return me
  105.     }
  106.  
  107. function set_sharps
  108.     {
  109.     shp=sharps
  110.     fillb 24 from sharps with 0
  111.     if (peekb bars and 192)<>192 then return 0
  112.  
  113.     n=bars+1
  114.     repeat 15
  115.     {
  116.     sy=peekb n:n++
  117.     if sy and 64 then
  118.         {
  119.         y=sy and 31
  120.         pokeb shp,y
  121.         pokeb shp+1,y+7
  122.         pokeb shp+2,y+14
  123.         shp+=3
  124.         }
  125.     }
  126.     return shp-sharps
  127.     }
  128.  
  129. proc play_music
  130.     {
  131.     play_it_again:
  132.     last_note=music_end
  133.     shp=set_sharps
  134.  
  135.     n=0:bar=0:bx=0
  136.     reps=0:rbar=0:rbx=0
  137.     intro_bar=0
  138.     while n<=last_note
  139.     {
  140.     sy=peekb (bars+n):n++
  141.     y=sy and 31
  142.     bx++:if bx>31 then bx=16:bar++:intro_bar=0
  143.     d=5
  144.     #long
  145.     if y then
  146.         {
  147.         #short
  148.         freq=peek (freq_table+y*4)
  149.         print_bars(bar)
  150.         px=(bx/16)*19+4+(bx and 15)
  151.         locate 2+y,px
  152.         video[locpos-1]b=120    ;highlight note.
  153.         if shp then
  154.         {
  155.         if searchb shp from sharps for y then
  156.             {
  157.             freq=peek ((freq_table-2)+y*4)  ;sharp!
  158.             }
  159.         }
  160.         if (intro_bar<>0) and ((sy and 64)=64) then goto dont_play
  161.         noise off:repeat 200 {}
  162.         noise 1,freq/2
  163.         d=4
  164.         }
  165.     dont_play:
  166.     if sy and 32 then
  167.         {
  168.         if reps<>n then
  169.         {
  170.         swap reps,n
  171.         swap rbar,bar
  172.         swap rbx,bx
  173.         }
  174.         }
  175.     if (sy and 192)=192 then
  176.         {
  177.         intro_bar=1
  178.         reps=n+15
  179.         rbar=bar+1
  180.         rbx=bx-1
  181.         }
  182.     ignore_key:
  183.     repeat d repeat tempo {}    ;delay.
  184.     if scan=1 then noise off:return     ;escape?
  185.     }
  186.     noise off
  187.     repeat 5 repeat 10000 {}
  188.     goto play_it_again
  189.     }
  190.  
  191. proc print_tab
  192.     {
  193.     lprint "MUSIC (C) Peter Campbell"
  194.     lprint "Music File: ";
  195.     m=mname+2
  196.     while peekb m lprint chr ucase peekb m;:m++
  197.     lprint cr lf
  198.  
  199.     last_note=music_end or 63        ;print even bars
  200.     shp=set_sharps
  201.     n=0
  202.  
  203.     line4:
  204.     bar=0
  205.     bx=0
  206.     xx=0
  207.     fillb 80   from tabl    with ' '
  208.     m=tabl+80
  209.     repeat 6*4
  210.     {
  211.     fillb 16 from m with '─'
  212.     poke m+16,2020h
  213.     poke m+18,2020h
  214.     m+=20
  215.     }
  216.  
  217.     while n<=last_note
  218.     {
  219.     sy=peekb (bars+n):n++
  220.     y=sy and 31
  221.     if y then
  222.         {
  223.         pokeb tabl+bx,peekb (note+y)    ;actual note.
  224.  
  225.         strg=peekb (gstring+y*2)
  226.         fret=peekb (gstring+1+y*2)
  227.         if shp then
  228.         {
  229.         if searchb shp from sharps for y then fret++
  230.         }
  231.         tm=tabl+strg*80+bx
  232.         pokeb tm,fret+'0'
  233.         }
  234.     if sy and 32 then
  235.         {
  236.         pokeb tabl+1+3*80+bx,'.'
  237.         pokeb tabl+1+4*80+bx,'.'
  238.         }
  239.     bx++:xx++
  240.     if xx>15 then
  241.         {
  242.         xx=0
  243.         bx+=4:bar++
  244.         if bar>3 then
  245.         {
  246.         m=tabl
  247.         if scan=1 then        ;cancel printing.
  248.             {
  249.             lprint chr 24;
  250.             return
  251.             }
  252.         repeat 80*7 lprint chr peekb m;:m++
  253.         lprint cr lf
  254.         goto line4
  255.         }
  256.         }
  257.     }
  258.     }
  259.  
  260. ;== Main Program ===========================================================
  261.  
  262. #inpend=0
  263. print bios "Music file name? ";
  264. inputs mname
  265. print bios
  266. if peekb (mname+2)=0 then error 999
  267. x=searchb 20 from mname+2 for 0
  268. moveb 3 from ext to x
  269.  
  270. fillb blen+16 from bars with 0
  271. #errors off
  272. load mname+2,bars,blen
  273. #errors on
  274. if error then
  275.     {
  276.     if error<>2 then error
  277.     print bios "Unknown file, create? ";
  278.     wait for keypressed
  279.     k=lcase key
  280.     if k<>'y' then error 999
  281.     }
  282.  
  283. cls
  284. locate 0,0:print "MUSIC PROGRAM (C) PETER CAMPBELL 1990"
  285. print "Current Music File: ";:prints mname+2,0
  286. fill 80 from video|320 with 7820h
  287.  
  288. bar=0
  289. bx=0
  290. nstep=2     ;16/nstep
  291.  
  292. forever
  293.     {
  294.     locate 0,60:print "Tempo=";4000-tempo;" ";
  295.     print_bars(bar)
  296.     nm=bars+bar*16+bx
  297.     oy=peekb nm:ny=oy and 31
  298.     put_note(oy,bx)
  299.     wait for keypressed
  300.     ks=keyscan:s=high ks:k=lcase low ks
  301.     if s=1 then
  302.     {
  303.     cursor 21,0
  304.     print bios "Saving file...";
  305.     save mname+2,bars,blen
  306.     print bios " ok"
  307.     stop
  308.     }
  309.  
  310.     if k='-' then tempo+=100:if tempo>3900 then tempo=3900
  311.     if k='+' then tempo-=100:if tempo<500 then tempo=500
  312.  
  313.     if s=72 then ny--
  314.     if s=80 then ny++
  315.     if s=73 then ny=0
  316.     if s=81 then ny=22
  317.     if ny<0 then ny=0
  318.     if ny>22 then ny=22
  319.     if (k>='a') and (k<='g') then
  320.     {
  321.     if ny=0 then ny=6
  322.     again:
  323.     x=searchb 8 from note+ny+1 for ucase k
  324.     if x=0 then ny=0:goto again
  325.     ny=x-note
  326.     }
  327.     if k='s' then oy=oy xor 64    ;s=sharp
  328.     if k='t' then oy=oy xor 128 ;t=flat temp!
  329.     if ks=21248 then oy=0:ny=0    ;remove note
  330.     pokeb nm,(oy and 224)+ny
  331.  
  332.     if k='p' then play_music
  333.     if ks=4864 then
  334.     {
  335.     m=bars+bar*16+(bx or 15)
  336.     pokeb m,peekb m xor 32        ;toggle repeat bit.
  337.     }
  338.     if ks=5888 then
  339.     {
  340.     m=bars+bar*16+(bx and 48)
  341.     pokeb m,peekb m xor 192     ;toggle intro bits.
  342.     }
  343.  
  344.     if s=75 then bx-=nstep
  345.     if s=77 then bx+=nstep
  346.     if s=71 then bx=bx and 48
  347.     if s=79 then bx=bx or 15
  348.     if ks=29696 then bx+=16
  349.     if ks=29440 then bx-=16
  350.     if ks=30464 then bar=0:bx=0
  351.     if ks=29952 then bar=36:bx=63
  352.     if ks=8192 then
  353.     {
  354.     m=bars+bar*16
  355.     moveb bend-m from m+16 to m
  356.     }
  357.     if ks=11776 then
  358.     {
  359.     m=bars+bar*16
  360.     moveb bend-m from m to m+16
  361.     }
  362.  
  363.     if ks=8704 then print_tab
  364.  
  365.     if bx>63 then bx=63:if bar<36 then bx=48:bar++
  366.     if bx<0  then bx=0:if bar then bx=15:bar--
  367.     if bar<0 then bar=0
  368.     if bar>36 then bar=36
  369.     }
  370.  
  371. ;== Data ===================================================================
  372.  
  373. mname:    string 20
  374. ext:    fname '.m'
  375.  
  376. note:    datab ' FEDCBAGFEDCBAGFEDCBAGF'
  377.  
  378. ;== Music Note Data ========================================================
  379.  
  380. ;old notes table
  381. ;4832b 4561c 4305c# 4063d 3855d# 3620e 3417f 3225f# 3044g 2873g# 2712a
  382. ;2560a# 2416b 2280c 2152c# 2032d 1918d# 1810e 1708f 1612f# 1522g 1437g# 1356a
  383.  
  384. freq_table:
  385. data 0
  386. data 0
  387. data 1708    ;f
  388. data 1810    ;***
  389. data 1810    ;e
  390. data 1918    ;d#
  391. data 2032    ;d
  392. data 2152    ;c#
  393. data 2280    ;c
  394. data 2416    ;***
  395. data 2416    ;b
  396. data 2560    ;a#
  397. data 2712    ;a
  398. data 2873    ;g#
  399. data 3044    ;g
  400. data 3225    ;f#
  401. data 3417    ;f
  402. data 3620    ;***
  403. data 3620    ;e
  404. data 3855    ;d#
  405. data 4063    ;d
  406. data 4305    ;c#
  407. data 4561    ;c
  408. data 4832    ;***
  409. data 4832    ;b
  410. data 5120    ;a#
  411. data 5424    ;a
  412. data 5746    ;g
  413. data 6088    ;g
  414. data 6450    ;f#
  415. data 6834    ;f
  416. data 7240    ;***
  417. data 7240    ;e
  418. data 7710    ;#
  419. data 8126    ;d
  420. data 8610    ;c#
  421. data 9122    ;c
  422. data 9664    ;***
  423. data 9664    ;b
  424. data 10240    ;a#
  425. data 10848    ;a
  426. data 11492    ;g#
  427. data 12196    ;g
  428. data 12900    ;f#
  429. data 13668    ;f
  430.  
  431. gstring:
  432. datab 0,0
  433. datab 1,13  ;f
  434. datab 1,12  ;e
  435. datab 1,10  ;d
  436. datab 1,8   ;c
  437. datab 1,7   ;b
  438. datab 1,5   ;a
  439. datab 2,8   ;g
  440. datab 2,6   ;f
  441. datab 2,5   ;e
  442. datab 3,7   ;d
  443. datab 3,5   ;c
  444. datab 3,4   ;b
  445. datab 4,7   ;a
  446. datab 4,5   ;g
  447. datab 5,8   ;f
  448. datab 5,7   ;e
  449. datab 5,5   ;d
  450. datab 6,8   ;c
  451. datab 6,7   ;b
  452. datab 6,5   ;a
  453. datab 6,3   ;g
  454. datab 6,1   ;f
  455.